home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / REFERENC / TPR / SOURCE.EXE / TEXTFILE.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-07  |  2KB  |  100 lines
  1. { TEXTFILE.PAS }
  2. program TextFiles;
  3. { Demonstrates copying a text file to another file }
  4.  
  5. var
  6.   DataLine    : String;
  7.   Error       : Integer;
  8.   InFileName  : String[80];
  9.   InFile      : Text;
  10.   Line        : Integer;
  11.   OutFileName : String[80];
  12.   OutFile     : Text;
  13.   TotalLines  : Word;
  14.   Response    : String[80];
  15.  
  16.  
  17. begin
  18.  
  19.   { Get name of input file and open the file }
  20.   Repeat
  21.  
  22.     Write('Enter the name of the file to read (CR=done): ');
  23.     Readln( InFileName );
  24.     if  Length( InFileName ) > 0  then
  25.     begin
  26.       Assign( InFile, InFileName );
  27.       {$I-}
  28.       Reset( InFile );
  29.       {$I+}
  30.       Error := IoResult;
  31.       if  Error <> 0 then
  32.         writeln('Unable to open ',InfileName,'.');
  33.     end; { if begin }
  34.  
  35.   Until (Error = 0) or (Length( InFileName ) = 0);
  36.  
  37.  
  38.   { Get name of output file and open the file }
  39.   If  Length( InFileName ) > 0 then
  40.   begin
  41.  
  42.     repeat
  43.       repeat
  44.         Error := 0;
  45.         Write('Enter the name of the file to COPY TO (CR=done): ');
  46.         Readln( OutFileName );
  47.         if  Length( OutFileName ) > 0 then
  48.         begin
  49.           Assign( OutFile, OutFileName );
  50.           {$I-}
  51.           Reset( OutFile );
  52.           {$I+}
  53.           Error := IoResult;
  54.           if  Error = 0  then
  55.           begin
  56.             Close ( OutFile );
  57.             Write(OutFileName,' already exists.  Overwrite (Y/Cr=No)? ');
  58.             Readln( Response );
  59.             if  (Response = 'Y') or (Response = 'y') then
  60.               Error := 1; { Allow exit from the filename query loop }
  61.           end; { if begin }
  62.         end; { if begin }
  63.       until (Error <> 0) or (Length( OutFileName ) = 0);
  64.  
  65.       if  Error <> 0  then
  66.       begin
  67.         {$I-}
  68.         Rewrite( OutFile );
  69.         {$I+}
  70.  
  71.         Error := IoResult;
  72.         if  Error <> 0  then
  73.           Writeln('Problem creating ',OutFileName,'.');
  74.       end; { if begin }
  75.  
  76.     until (Error = 0) or (Length( OutFileName ) = 0);
  77.  
  78.  
  79.     { Copy the input file to the output file }
  80.     if  Length( OutFileName ) > 0  then
  81.     begin
  82.  
  83.       while not Eof(InFile) do
  84.       begin
  85.         Readln( InFile, DataLine );
  86.         Writeln( OutFile, DataLine );
  87.  
  88.         { Write a dot on the screen for each line copied }
  89.         Write('.');
  90.       end; { while }
  91.       Writeln;
  92.  
  93.       Close( InFile );
  94.       Close( OutFile );
  95.     end; { if begin }
  96.  
  97.   end; { if begin }
  98.  
  99. end. { program }
  100.